Cooperators have low degrees
#Define degrees of isolation
isolationDegree = 2
#number of iterations per arm
iterations = 500
modelForPrediction = "random forest" #"linear" or "random forest"
# List of manipulating parameters of experiments
#L : number of rounds
#V : Visible or not
#A : Income of a rich-group subject
#B : Income of a poor-group subject
#R : Probability to be assigned to a rich group
#I : Number of the same-parameter trial
R = 0.5
I = 0
L = 10
trends.df = data.frame()
for(A in c(1150,700,500)){
for(V in c(0,1)){
V = V
A = A
if(A==1150){B = 200} #high inequality
if(A==700){B = 300} #low inequality
if(A==500){B = 500} #no inequality
if(modelForPrediction=="random forest"){
source(paste(rootdir,"R/models.R",sep="/"))
if(V==0){
model1<-model1.invisible(redo=FALSE)
model2<-model2.invisible(redo=FALSE)
model3<-model3(redo=FALSE)
}
if(V==1){
model1<-model1.visible(redo=FALSE)
model2<-model2.visible(redo=FALSE)
model3<-model3(redo=FALSE)
}
}
df.netIntLowDegree = data.frame(
coopFrac = NULL,
avgCoop = NULL,
avgCoopFinal = NULL,
percentIsolation = NULL,
isolation = NULL,
percentIsolationC = NULL,
percentIsolationD = NULL,
nCommunities = NULL,
communitySize = NULL,
assortativityInitial = NULL,
assortativityFinal = NULL,
conversionRate = NULL,
conversionToD = NULL,
conversionToC = NULL,
transitivity = NULL,
degree = NULL,
degreeC = NULL,
degreeD = NULL,
meanConversionToD = NULL,
meanConversionToC = NULL,
degreeLost = NULL,
degreeLostC = NULL,
degreeLostD = NULL
)
#Here, factionCoop=0 will be the control: no rearranging of nodes will take place
for(frac in c(0,0.25,0.5,0.75,1)){
#nodes in the top fractionCoop degrees will automatically be a cooperator
fractionCoop = frac
coopFrac = NULL
avgCoop = NULL
homophilyC = NULL
homophilyD = NULL
heterophily = NULL
avgCoopFinal = NULL
percentIsolation = NULL
isolation = NULL
percentIsolationC = NULL
percentIsolationD = NULL
nCommunities = NULL
communitySize = NULL
assortativityInitial = NULL
assortativityFinal = NULL
conversionRate = NULL
conversionToD = NULL
conversionToC = NULL
transitivity = NULL
degree = NULL
degreeC = NULL
degreeD = NULL
meanConversionToD = NULL
meanConversionToC = NULL
degreeLost = NULL
degreeLostC = NULL
degreeLostD = NULL
avg_wealth = NULL
gini = NULL
for(m in c(1:iterations)){
# Section 1. NOTES, packages, and Parameters
#Importing library
library(igraph) # for network graphing
library(reldist) # for gini calculatio
library(boot) # for inv.logit calculation
#Two prefixed functions
#rank
rank1 = function(x) {rank(x,na.last=NA,ties.method="average")[1]} #a smaller value has a smaller rank.
#gini mean difference (a.k.a. mean difference: please refer to https://stat.ethz.ch/pipermail/r-help/2003-April/032782.html)
gmd = function(x) {
x1 = na.omit(x)
n = length(x1)
tmp = 0
for (i in 1:n) {
for (j in 1:n) {
tmp <- tmp + abs(x1[i]-x1[j])
}
}
answer = tmp/(n*n)
return(answer)
}
# List of fixed parameters of experiments (assumptions)
#Rewiring rate = 0.3
#GINI coefficient (can be known by A or B)
GINI = 0*as.numeric(A==500) + 0.2*as.numeric(A %in% c(700,850)) + 0.4*as.numeric(A ==1150)
#Collecting data frame (final output data frame)
result = data.frame(round=0:L,n_par=NA,n_A=NA,avg_coop=NA,avg_degree=NA,avg_wealth=NA,gini=NA,gmd=NA,avg_coop_A=NA,avg_degree_A=NA,avg_wealth_A=NA,gini_A=NA,gmd_A=NA,avg_coop_B=NA,avg_degree_B=NA,avg_wealth_B=NA,gini_B=NA,gmd_B=NA,isolation=NA,percentIsolation=NA,meanConversionToD=NA,meanConversionToC=NA,degreeLost=NA,degreeLostC=NA,degreeLostD=NA)
#_A is for a richer group and _B is for a poorer group
#####################################################
# Section 1.5: Practice rounds 1 to 2, to determine C/D in round 1
N = 17 # median of the number of participants over rounds.
node_rp0 = data.frame(ego_id=1:N, round=0)
node_import = node_rp0
for (k in 1:2){
node_rX = node_import #Importing data
node_rX$round = node_rX$round + 1
node_rX[is.na(node_rX$prev_degree)==1,"prev_degree"] = 0
node_rX[is.na(node_rX$prev_local_rate_coop)==1,"prev_local_rate_coop"] = 0
#Only this calculation needs to change from Round 1
if (k==1) {
node_rX$prob_coop = inv.logit(1.099471)
} else {
node_rX$prob_coop = inv.logit((-0.02339288) + (1.46068980)*as.numeric(node_rX$prev_coop==1))
}
node_rX$coop = apply(data.frame(node_rX$prob_coop),1,function(x) {sample(1:0,1,prob=c(x,(1-x)))})
node_rX$prev_coop = node_rX$coop
assign(paste("coop_rp",k, sep=""),node_rX$coop)
#For the loop
node_import = node_rX
}
#cooperation rate in the practice rounds
coop_rp1 <- rbinom(n = 17, size = 1, prob = 0.6)
coop_rp2 <- abs(coop_rp1 - rbinom(n = 17, size = 1, prob = 0.1))
coop_rp = apply(cbind(coop_rp1,coop_rp2),1,mean)
#####################################################
# Section 2: Round 0 (Agents and environments)
#Node data generation
N = 17 # median of the number of participants over rounds.
node_r0 = data.frame(ego_id=1:N, round=0)
node_r0$coop_rp = ifelse(coop_rp==1,"C","D")
node_r0$group = sample(c("rich","poor"),N,replace=TRUE,prob=c(R,1-R)) #R is defined as the probability to be assigned to the rich group
node_r0$initial_wealth = ifelse(node_r0$group=="rich",A,B)
#Link data generation
ego_list = NULL
for (i in 1:N) { ego_list = c(ego_list,rep(i,N)) }
link_r0 = data.frame(ego_id=ego_list,alt_id=rep(1:N,N))
link_r0 = link_r0[(link_r0$ego_id < link_r0$alt_id),] #The link was bidirectional, and thus the half and self are omitted.
link_r0$connected = sample(0:1,dim(link_r0)[1],replace=TRUE,prob=c(0.7,0.3)) #Initial rewiring rate is fixed, 0.3
link_r0c_ego = link_r0[link_r0$connected==1,]
link_r0c_alt = link_r0[link_r0$connected==1,]
colnames(link_r0c_alt) = c("alt_id","ego_id","connected")
link_r0c = rbind(link_r0c_ego,link_r0c_alt) #this is bidirectional (double counted) for connected ties.
link_r0c = link_r0c[order(link_r0c$ego_id),]
link_r0c$alternumber = NA #putting the number for each alter in the same ego
link_r0c[1,]$alternumber = 1
for (i in 1:(dim(link_r0c)[1]-1))
{if (link_r0c[i,]$ego_id == link_r0c[i+1,]$ego_id)
{link_r0c[i+1,]$alternumber = link_r0c[i,]$alternumber + 1}
else
{link_r0c[i+1,]$alternumber = 1}
#print(i)
}
link_r0c2 = reshape(link_r0c, direction = "wide", idvar=c("ego_id","connected"), timevar="alternumber")
link_r0c2$initial_degree = apply(link_r0c2[,colnames(link_r0c2)[substr(colnames(link_r0c2),1,6) == "alt_id"]],1,function(x){length(na.omit(x))}) #Degree of each ego
link_r0c2[is.na(link_r0c2$initial_degree)==1,"initial_degree"] = 0
#Reflect the degree and initial local gini coefficient into the node data
node_r0 = merge(x=node_r0,y=link_r0c2,all.x=TRUE,all.y=FALSE,by="ego_id")
node_r0$initial_avg_env_wealth = NA
node_r0$initial_local_gini = NA #local gini coefficient of the ego and connecting alters
node_r0$initial_rel_rank = NA #local rank of ego among the ego and connecting alters (divided by the number of the go and connecting alters)
for (i in 1:(dim(node_r0)[1])){
node_r0[i,]$initial_avg_env_wealth = mean(na.omit(node_r0[node_r0$ego_id %in%
node_r0[i,colnames(node_r0)[substr(colnames(node_r0),1,6) %in% c("ego_id","alt_id")]],"initial_wealth"]))
node_r0[i,]$initial_local_gini = gini(na.omit(node_r0[node_r0$ego_id %in% node_r0[i,colnames(node_r0)[substr(colnames(node_r0),1,6)
%in% c("ego_id","alt_id")]],"initial_wealth"]))
node_r0[i,]$initial_rel_rank = rank1(na.omit(node_r0[node_r0$ego_id %in% node_r0[i,colnames(node_r0)[substr(colnames(node_r0),1,6)
%in% c("ego_id","alt_id")]],"initial_wealth"]))/length(na.omit(node_r0[node_r0$ego_id %in%
node_r0[i,colnames(node_r0)[substr(colnames(node_r0),1,6) %in% c("ego_id","alt_id")]],"initial_wealth"]))
}
#Finalization of round 0 and Visualization
#plot(graph.data.frame(link_r0[link_r0$connected==1,],directed=F)) #plot.igraph
node_r0$everIsolated = 0
node_r0$maxDegreeLost = NA
result[result$round==0,2:25] = c(length(node_r0$ego_id),length(node_r0[node_r0$group=="rich",]$ego_id),NA,mean(node_r0$initial_degree),mean(node_r0$initial_wealth),gini(node_r0$initial_wealth),gmd(node_r0$initial_wealth),NA,mean(node_r0[node_r0$group=="rich",]$initial_degree),mean(node_r0[node_r0$group=="rich",]$initial_wealth),gini(node_r0[node_r0$group=="rich",]$initial_wealth),gmd(node_r0[node_r0$group=="rich",]$initial_wealth),NA,mean(node_r0[node_r0$group=="poor",]$initial_degree),mean(node_r0[node_r0$group=="poor",]$initial_wealth),gini(node_r0[node_r0$group=="poor",]$initial_wealth),gmd(node_r0[node_r0$group=="poor",]$initial_wealth),
as.numeric(ifelse(is.na(table(node_r0$initial_degree<=isolationDegree)["TRUE"]),0,1)),
as.numeric(sum(node_r0$everIsolated)/length(node_r0$ego_id)),
NA,
NA,
NA,NA,NA
)
#For the loop at the next round (for round 1, the initial one is the same as the previous [1 prior] one)
node_import = node_r0
node_import$initial_coop = NA
node_import$prev_coop = NA
node_import$prev_wealth = node_import$initial_wealth
node_import$prev_degree = node_import$initial_degree
node_import$prev_avg_env_wealth = node_import$initial_avg_env_wealth
node_import$prev_local_gini = node_import$initial_local_gini
node_import$prev_rel_rank = node_import$initial_rel_rank
node_import$prev_local_rate_coop = NA
link_import = link_r0
#####################################################
# Section 3: Rounds 1 to 10 or more (behaviors in simulation: the equation of cooperation is different at round 1 because of no history)
#3-1: Cooperation phase
for (k in 1:L)
{
node_rX = node_import #Importing data
node_rX$round = node_rX$round + 1
node_rX[is.na(node_rX$prev_degree)==1,"prev_degree"] = 0
node_rX[is.na(node_rX$prev_local_rate_coop)==1,"prev_local_rate_coop"] = 0
#Only this calculation needs to change from Round 1
if(modelForPrediction=="linear"){
if (k==1) {
node_rX$prob_coop = as.numeric(V==0)*inv.logit((-1.816665) + (2.086067)*coop_rp1 + (1.800153)*coop_rp2) + as.numeric(V==1)*inv.logit((-2.031577) + (2.427157)*coop_rp1 + (1.684193)*coop_rp2 + (-1.528851)*GINI)
} else {
node_rX$prob_coop = as.numeric(V==0 & node_rX$prev_coop==0)*inv.logit(-1.039916) + as.numeric(V==0 & node_rX$prev_coop==1)*inv.logit(2.062023) + as.numeric(V==1 & node_rX$prev_coop==0)*inv.logit((-0.2574838)*as.numeric(node_rX$prev_avg_env_wealth - node_rX$prev_wealth > 0) + (-1.214198)*GINI + (2.508148)*GINI*as.numeric(node_rX$prev_avg_env_wealth - node_rX$prev_wealth > 0) + (-0.9749075)) + as.numeric(V==1 & node_rX$prev_coop==1)*inv.logit((- 0.6197254)*as.numeric(node_rX$prev_avg_env_wealth - node_rX$prev_wealth > 0) + (-0.7480261)*GINI + (1.169674)*GINI*as.numeric(node_rX$prev_avg_env_wealth - node_rX$prev_wealth > 0) + (1.356784))
}
}
if(modelForPrediction=="random forest"){
if (k==1) {
if(V==1){node_rX$prob_coop = predict(model1,
newdata=
data.frame(
behavior.p1 = coop_rp1,
behavior.p2 = coop_rp2,
gini = GINI
),
type = "prob"
)[[1]]$C}
else if(V==0){node_rX$prob_coop = predict(model1,
newdata=
data.frame(
behavior.p1 = coop_rp1,
behavior.p2 = coop_rp2
),
type = "prob"
)[[1]]$C}
} else {
if(V==1){node_rX$prob_coop = predict(model2,
newdata=
data.frame(
prevCoop = node_rX$prev_coop,
gini = GINI,
alterPrevWealth = node_rX$prev_avg_env_wealth,
egoPrevWealth = node_rX$prev_wealth
),
type = "prob"
)[[1]]$C}
else if(V==0){node_rX$prob_coop = predict(model2,
newdata=
data.frame(
prevCoop = node_rX$prev_coop,
alterPrevWealth = node_rX$prev_avg_env_wealth,
egoPrevWealth = node_rX$prev_wealth
),
type = "prob"
)[[1]]$C}
}
}
#####rearrange node degrees before round 1 depending on cooperation in practice rounds!
if(k==1){
if(fractionCoop==0){
node_rX$prob_coop
node_rX$coop = apply(data.frame(node_rX$prob_coop),1,function(x) {sample(1:0,1,prob=c(x,(1-x)))})
coop_rp_init = coop_rp
}
if(fractionCoop>0){
prob_coop_df = NULL
nodesCoop = NULL
#nodesCoop = node_rX$prev_degree<=quantile(node_rX$prev_degree,fractionCoop) #assign low-degree nodes to cooperators
#assign defectors to designated nodes
nodesCoop = node_rX$prev_degree<=floor(quantile(node_rX$prev_degree,fractionCoop)) & node_rX$prev_degree>=floor(quantile(node_rX$prev_degree,fractionCoop-0.25))
prob_coop_df =
data.frame(
prob_coop = rev(node_rX$prob_coop[order(coop_rp)]),
node_number = c(which(!nodesCoop),which(nodesCoop))
)
node_rX$prob_coop = prob_coop_df[order(prob_coop_df$node_number),]$prob_coop
#coop_rp of the rearranged nodes
coop_rp_init = rev(coop_rp[order(coop_rp)])[order(prob_coop_df$node_number)]
node_rX$coop = apply(data.frame(node_rX$prob_coop),1,function(x) {sample(1:0,1,prob=c(x,(1-x)))})
}
} else {
node_rX$coop = apply(data.frame(node_rX$prob_coop),1,function(x) {sample(1:0,1,prob=c(x,(1-x)))})
}
if (k==1) {
node_rX$initial_coop = node_rX$coop
} else {
node_rX$initial_coop = node_rX$initial_coop
}
node_rX$cost = (-50)*node_rX$coop*node_rX$prev_degree
node_rX$n_coop_received = NA
for (i in 1:(dim(node_rX)[1]))
{
node_rX[i,]$n_coop_received = sum(node_rX[node_rX$ego_id %in% node_rX[i,colnames(node_rX)[substr(colnames(node_rX),1,6) ==
"alt_id"]],"coop"])
}
node_rX$benefit = 100*node_rX$n_coop_received
node_rX$payoff = node_rX$cost + node_rX$benefit
node_rX$wealth = node_rX$prev_wealth + node_rX$payoff
node_rX$rel_rank = NA
node_rX$local_rate_coop = NA
for (i in 1:dim(node_rX)[1])
{
node_rX[i,]$rel_rank = rank1(na.omit(node_rX[node_rX$ego_id %in% node_rX[i,colnames(node_rX)[substr(colnames(node_rX),1,6) %in%
c("ego_id","alt_id")]],"wealth"]))/length(na.omit(node_rX[node_rX$ego_id %in%
node_rX[i,colnames(node_rX)[substr(colnames(node_rX),1,6) %in% c("ego_id","alt_id")]],"wealth"]))
node_rX[i,]$local_rate_coop = mean(na.omit(node_rX[node_rX$ego_id %in% node_rX[i,colnames(node_rX)[substr(colnames(node_rX),1,6) %in%
c("ego_id","alt_id")]],"coop"]))
}
node_rX$growth = as.numeric((node_rX$wealth/node_rX$prev_wealth) > 1)
node_rX = node_rX[,c("ego_id","round","group","prev_degree","initial_wealth","initial_local_gini","initial_coop","coop","wealth","rel_rank","local_rate_coop","growth","everIsolated","maxDegreeLost")] #Pruning the previous-round data (degree is not updating yet)
#3-2: Rewiring phase
# 30% of ties (unidirectional) are being rewired
link_rX_1 = link_import #Importing data (bidirectioanl ego-alter [ego_id < alter_id])
colnames(link_rX_1) = c("ego_id","alt_id","prev_connected")
link_rX_1$challenge = sample(0:1,dim(link_rX_1)[1],replace=TRUE,prob=c(0.7,0.3)) # The bidirectional ties being rewired are selected (rewiring rate = 0.3).
ego_node_data =
node_rX[,c("ego_id","wealth","coop","prev_degree","initial_wealth","initial_local_gini","initial_coop","rel_rank","local_rate_coop","growth")]
colnames(ego_node_data) =
c("ego_id","ego_wealth","ego_coop","ego_prev_degree","ego_initial_wealth","ego_initial_local_gini","ego_initial_coop","ego_rel_rank","ego_local_rate_coop","ego_growth")
alt_node_data =
node_rX[,c("ego_id","wealth","coop","prev_degree","initial_wealth","initial_local_gini","initial_coop","rel_rank","local_rate_coop","growth")]
colnames(alt_node_data) =
c("alt_id","alt_wealth","alt_coop","alt_prev_degree","alt_initial_wealth","alt_initial_local_gini","alt_initial_coop","alt_rel_rank","alt_local_rate_coop","alt_growth")
link_rX_2 = merge(x=link_rX_1,y=ego_node_data,all.x=TRUE,all.y=FALSE,by="ego_id")
link_rX_3 = merge(x=link_rX_2,y=alt_node_data,all.x=TRUE,all.y=FALSE,by="alt_id")
link_rX_3$choice = sample(c("ego","alt"),dim(link_rX_3)[1],replace=TRUE,prob=c(0.5,0.5)) #decision maker for breaking a link, which is a unilateral decision
#ego_prob: probability of choosing to connect when challenged (asked)
if(modelForPrediction=="linear"){
link_rX_3$ego_prob = inv.logit((0.5134401)*link_rX_3$prev_connected + (-0.852406)*link_rX_3$ego_coop + (2.96549)*link_rX_3$alt_coop + (-0.1808545))
link_rX_3$alt_prob = inv.logit((0.5134401)*link_rX_3$prev_connected + (-0.852406)*link_rX_3$alt_coop + (2.96549)*link_rX_3$ego_coop + (-0.1808545))}
if(modelForPrediction=="random forest"){
link_rX_3$ego_prob = predict(model3,
newdata=
data.frame(
previouslyconnected = link_rX_3$prev_connected,
ego_behavior = link_rX_3$ego_coop,
alter_behavior = link_rX_3$alt_coop
),
type = "prob"
)[[1]]$C
link_rX_3$alt_prob = predict(model3,
newdata=
data.frame(
previouslyconnected = link_rX_3$prev_connected,
ego_behavior = link_rX_3$alt_coop,
alter_behavior = link_rX_3$ego_coop
),
type = "prob"
)[[1]]$C
}
link_rX_3$prob_connect = ifelse(link_rX_3$prev_connected == 1, ifelse(link_rX_3$choice == "ego", link_rX_3$ego_prob,
link_rX_3$alt_prob), link_rX_3$ego_prob*link_rX_3$alt_prob)
link_rX_3$connect_update = apply(data.frame(link_rX_3$prob_connect),1, function(x) {sample(1:0,1,prob=c(x,(1-x)))})
link_rX_3$connected = ifelse(link_rX_3$challenge==0,link_rX_3$prev_connected,link_rX_3$connect_update)
link_rX = link_rX_3[,c("ego_id","alt_id","connected")] #pruning and data is updated
#Reflect the degree and local gini coefficient into the node data
link_rXc_ego = link_rX[link_rX$connected==1,]
link_rXc_alt = link_rX[link_rX$connected==1,]
colnames(link_rXc_alt) = c("alt_id","ego_id","connected")
link_rXc = rbind(link_rXc_ego,link_rXc_alt)
link_rXc = link_rXc[order(link_rXc$ego_id),]
link_rXc$alternumber = NA
link_rXc[1,]$alternumber = 1
for (i in 1:(dim(link_rXc)[1]-1))
{
if (link_rXc[i,]$ego_id == link_rXc[i+1,]$ego_id)
{
link_rXc[i+1,]$alternumber = link_rXc[i,]$alternumber + 1
}
else
{
link_rXc[i+1,]$alternumber = 1
}
#print(i)
}
link_rXc2 = reshape(link_rXc, direction = "wide", idvar=c("ego_id","connected"), timevar="alternumber")
link_rXc2$degree = apply(link_rXc2[,colnames(link_rXc2)[substr(colnames(link_rXc2),1,3) == "alt"]],1,function(x) {length(na.omit(x))})
node_rX_final = merge(x=node_rX[,c("ego_id","round","group","initial_wealth","initial_local_gini","initial_coop","coop","wealth","growth","everIsolated","maxDegreeLost")],y=link_rXc2,all.x=TRUE,all.y=FALSE,by="ego_id")
node_rX_final[is.na(node_rX_final$degree)==1,"degree"] = 0
node_rX_final$avg_env_wealth = NA
node_rX_final$local_gini = NA #needs to be updated because the social network changes at the rewiring phase
node_rX_final$local_rate_coop = NA
node_rX_final$rel_rank = NA
for (i in 1:dim(node_rX_final)[1])
{
node_rX_final[i,]$avg_env_wealth = mean(na.omit(node_rX_final[node_rX_final$ego_id %in%
node_rX_final[i,colnames(node_rX_final)[substr(colnames(node_rX_final),1,6) %in% c("ego_id","alt_id")]],"wealth"]))
node_rX_final[i,]$local_gini = gini(na.omit(node_rX_final[node_rX_final$ego_id %in%
node_rX_final[i,colnames(node_rX_final)[substr(colnames(node_rX_final),1,6) %in% c("ego_id","alt_id")]],"wealth"]))
node_rX_final[i,]$local_rate_coop = mean(na.omit(node_rX_final[node_rX_final$ego_id %in%
node_rX_final[i,colnames(node_rX_final)[substr(colnames(node_rX_final),1,6) %in% c("ego_id","alt_id")]],"coop"]))
node_rX_final[i,]$rel_rank = rank1(na.omit(node_rX_final[node_rX_final$ego_id %in%
node_rX_final[i,colnames(node_rX_final)[substr(colnames(node_rX_final),1,6) %in%
c("ego_id","alt_id")]],"wealth"]))/length(na.omit(node_rX_final[node_rX_final$ego_id %in%
node_rX_final[i,colnames(node_rX_final)[substr(colnames(node_rX_final),1,6) %in% c("ego_id","alt_id")]],"wealth"]))
node_rX_final[i,]$everIsolated = ifelse(node_rX_final[i,]$everIsolated==1,1,ifelse(node_rX_final[i,]$degree<=isolationDegree,1,0))
node_rX_final[i,]$maxDegreeLost = pmax(node_r0[i,]$initial_degree - node_rX_final[i,]$degree, node_rX_final[i,]$maxDegreeLost, na.rm=TRUE)
}
#Finalization of round X and Visualization
#plot(graph.data.frame(link_rX[link_rX$connected==1,],directed=F)) #plot.igraph
result[result$round==k,2:25] =
c(length(node_rX_final$ego_id),length(node_rX_final[node_rX_final$group=="rich",]$ego_id),mean(node_rX_final$coop),mean(node_rX_final$degree),mean(node_rX_final$wealth),gini(node_rX_final$wealth),gmd(node_rX_final$wealth),mean(node_rX_final[node_rX_final$group=="rich",]$coop),mean(node_rX_final[node_rX_final$group=="rich",]$degree),mean(node_rX_final[node_rX_final$group=="rich",]$wealth),gini(node_rX_final[node_rX_final$group=="rich",]$wealth),gmd(node_rX_final[node_rX_final$group=="rich",]$wealth),mean(node_rX_final[node_rX_final$group=="poor",]$coop),mean(node_rX_final[node_rX_final$group=="poor",]$degree),mean(node_rX_final[node_rX_final$group=="poor",]$wealth),gini(node_rX_final[node_rX_final$group=="poor",]$wealth),gmd(node_rX_final[node_rX_final$group=="poor",]$wealth),
as.numeric(ifelse(is.na(table(node_rX_final$degree<=isolationDegree)["TRUE"]),0,1)),
as.numeric(sum(node_rX_final$everIsolated)/length(node_rX_final$ego_id)),
prop.table(table(node_rX_final[node_rX_final$initial_coop==1]$coop))["0"],
prop.table(table(node_rX_final[node_rX_final$initial_coop==0]$coop))["1"],
suppressWarnings({mean(node_rX_final$maxDegreeLost,na.rm=TRUE)}),
suppressWarnings({mean(node_rX_final[node_rX_final$initial_coop==1]$maxDegreeLost,na.rm=TRUE)}),
suppressWarnings({mean(node_rX_final[node_rX_final$initial_coop==0]$maxDegreeLost,na.rm=TRUE)})
)
#For the loop
node_import = node_rX_final
colnames(node_import)[colnames(node_import) %in%
c("coop","wealth","growth","degree","avg_env_wealth","local_gini","local_rate_coop","rel_rank")] =
c("prev_coop","prev_wealth","prev_growth","prev_degree","prev_avg_env_wealth","prev_local_gini","prev_local_rate_coop","prev_rel_rank")
link_import = link_rX
#print(paste0("Round ",k," is done."))
}
trends.df = rbind(trends.df,cbind(result[c("round","gini","gmd","avg_wealth","avg_coop","avg_degree")],V,GINI,fractionCoop))
link_rX_final = data.table::melt(setDT(node_rX_final),
measure = patterns('alt_id'),
variable.name = 'linkNumber',
value.name = c('alt_id'))
link_rX_final = data.frame(link_rX_final)[c("ego_id","alt_id")]
link_rX_final = link_rX_final[complete.cases(link_rX_final),]
link_rX_final = data.frame(t(unique(apply(link_rX_final, 1, function(x) sort(x))))) %>% distinct(X1, X2)
node_g_final = data.frame(node_rX_final)[c("ego_id","initial_coop","coop")]
node_g_final$initial_coop = factor(node_g_final$initial_coop)
g_rX_final = graph_from_data_frame(link_rX_final, directed = FALSE, vertices=node_g_final)
g_r0 = graph_from_data_frame(link_r0[link_r0$connected==1,][1:2], directed = FALSE, vertices=node_r0)
E(g_r0)$coopEdgeC = sapply(E(g_r0), function(e) prod(ifelse(V(g_r0)[inc(e)]$coop_rp=="C",1,0)))
E(g_r0)$coopEdgeD = sapply(E(g_r0), function(e) prod(ifelse(V(g_r0)[inc(e)]$coop_rp=="D",1,0)))
E(g_r0)$coopEdgeCD = sapply(E(g_r0), function(e) ifelse(sum(ifelse(V(g_r0)[inc(e)]$coop_rp=="C",1,0))==1,1,0))
#C-assortativity, defined as number of observed C-C edges out of total possible C-C edges
homophilyC[m] = sum(E(g_r0)$coopEdgeC) / (table(V(g_r0)$coop_rp)["C"]*(table(V(g_r0)$coop_rp)["C"]-1)/2)
#D-assortativity, defined as number of observed C-C edges out of total possible C-C edges
homophilyD[m] = sum(E(g_r0)$coopEdgeD) / (table(V(g_r0)$coop_rp)["D"]*(table(V(g_r0)$coop_rp)["D"]-1)/2)
#heterophily, defined as number of observed C-D edges out of total possible C-D edges
heterophily[m] = sum(E(g_r0)$coopEdgeCD) / (table(V(g_r0)$coop_rp)["C"]*table(V(g_r0)$coop_rp)["D"])
coopFrac[m] = fractionCoop
avgCoop[m] = prop.table(table(V(g_r0)$coop_rp))["C"]
avgCoopFinal[m] = result[result$round==10,]$avg_coop
percentIsolation[m] = max(result[result$round>=1,]$percentIsolation)
isolation[m] = max(result[result$round>=1,]$isolation)
#percentage of isolation among those who cooperated in both practice rounds
percentIsolationC[m] = sum(node_rX_final[coop_rp_init==1,]$everIsolated)/length(node_rX_final[coop_rp_init==1,]$everIsolated)
#percentage of isolation among those who defected at least once in practice rounds
percentIsolationD[m] = sum(node_rX_final[coop_rp_init<=0.5,]$everIsolated)/length(node_rX_final[coop_rp_init<=0.5,]$everIsolated)
nCommunities[m] = max(membership(cluster_louvain(g_rX_final)),na.rm=TRUE)
communitySize[m] = mean(table(membership(cluster_louvain(g_rX_final))),na.rm=TRUE)
assortativityInitial[m] = assortativity(g_r0, V(g_r0)$coop_rp == "C")
assortativityFinal[m] = assortativity(g_rX_final, V(g_r0)$coop_rp == "C")
conversionRate[m] = prop.table(table(V(g_rX_final)$coop == ifelse(V(g_r0)$coop_rp=="C","1","0")))["FALSE"]
conversionToD[m] = prop.table(table(V(g_rX_final)$coop[V(g_r0)$coop_rp == "C"]))["0"]
conversionToC[m] = prop.table(table(V(g_rX_final)$coop[V(g_r0)$coop_rp == "C"]))["1"]
transitivity[m] = mean(transitivity(g_rX_final, type="global"),na.rm=TRUE)
degree[m] = mean(igraph::degree(g_rX_final),na.rm=TRUE)
degreeC[m] = mean(igraph::degree(g_r0)[coop_rp_init==1],na.rm=TRUE)
degreeD[m] = mean(igraph::degree(g_r0)[coop_rp_init<=0.5],na.rm=TRUE)
meanConversionToD[m] = mean(result[result$round>=2,]$meanConversionToD, na.rm=TRUE)
meanConversionToC[m] = mean(result[result$round>=2,]$meanConversionToC, na.rm=TRUE)
degreeLost[m] = result[result$round==10,]$degreeLost
degreeLostC[m] = result[result$round==10,]$degreeLostC
degreeLostD[m] = result[result$round==10,]$degreeLostD
avg_wealth[m] = result[result$round==10,]$avg_wealth
gini[m] = result[result$round==10,]$gini
}
df.netIntLowDegree = rbind(df.netIntLowDegree,
data.frame(
coopFrac = coopFrac,
avgCoop = avgCoop,
avgCoopFinal = avgCoopFinal,
percentIsolation = percentIsolation,
isolation = isolation,
percentIsolationC = percentIsolationC,
percentIsolationD = percentIsolationD,
nCommunities = nCommunities,
communitySize = communitySize,
assortativityInitial = assortativityInitial,
assortativityFinal = assortativityFinal,
conversionRate = conversionRate,
conversionToD = conversionToD,
conversionToC = conversionToC,
homophilyC = homophilyC,
homophilyD = homophilyD,
heterophily = heterophily,
transitivity = transitivity,
degree = degree,
degreeC = degreeC,
degreeD = degreeD,
meanConversionToD = meanConversionToD,
meanConversionToC = meanConversionToC,
degreeLost = degreeLost,
degreeLostC = degreeLostC,
degreeLostD = degreeLostD,
avg_wealth = avg_wealth,
gini = gini
))
#plot(g_r0,vertex.color=V(g_rX_final)$initial_coop,vertex.label=ifelse(is.na(V(g_rX_final)$initial_coop),"NA",ifelse(V(g_rX_final)$initial_coop==1,"C","D")),main=paste("fracCoop=",frac,", round 0",sep=""))
#plot(g_rX_final,vertex.color=V(g_rX_final)$initial_coop,vertex.label=ifelse(is.na(V(g_rX_final)$initial_coop),"NA",ifelse(V(g_rX_final)$initial_coop==1,"C","D")),main=paste("fracCoop=",frac,", final round",sep=""))
}
sum.netIntLowDegree <- data.frame(
df.netIntLowDegree %>%
group_by(coopFrac) %>%
summarise(
mean.isolation = mean(isolation),
ci.isolation = 1.96 * sd(isolation)/sqrt(n()),
mean.percentIsolation = mean(percentIsolation),
ci.percentIsolation = 1.96 * sd(percentIsolation)/sqrt(n()),
mean.percentIsolationC = mean(percentIsolationC,na.rm=TRUE),
ci.percentIsolationC = 1.96 * sd(percentIsolationC,na.rm=TRUE)/sqrt(sum(isolation)),
mean.percentIsolationD = mean(percentIsolationD,na.rm=TRUE),
ci.percentIsolationD = 1.96 * sd(percentIsolationD,na.rm=TRUE)/sqrt(sum(isolation)),
mean.avgCoop = mean(avgCoop,na.rm=TRUE),
ci.avgCoop = 1.96 * sd(avgCoop,na.rm=TRUE)/sqrt(n()),
mean.avgCoopFinal = mean(avgCoopFinal,na.rm=TRUE),
ci.avgCoopFinal = 1.96 * sd(avgCoopFinal,na.rm=TRUE)/sqrt(n()),
mean.nCommunities = mean(nCommunities,na.rm=TRUE),
ci.nCommunities = 1.96 * sd(nCommunities,na.rm=TRUE)/sqrt(n()),
mean.communitySize = mean(communitySize,na.rm=TRUE),
ci.communitySize = 1.96 * sd(communitySize,na.rm=TRUE)/sqrt(n()),
mean.assortativityInitial = mean(assortativityInitial,na.rm=TRUE),
ci.assortativityInitial = 1.96 * sd(assortativityInitial,na.rm=TRUE)/sqrt(n()),
mean.assortativityFinal = mean(assortativityFinal,na.rm=TRUE),
ci.assortativityFinal = 1.96 * sd(assortativityFinal,na.rm=TRUE)/sqrt(n()),
mean.conversionRate = mean(conversionRate,na.rm=TRUE),
ci.conversionRate = 1.96 * sd(conversionRate,na.rm=TRUE)/sqrt(n()),
mean.conversionToD = mean(conversionToD,na.rm=TRUE),
ci.conversionToD = 1.96 * sd(conversionToD,na.rm=TRUE)/sqrt(n()),
mean.conversionToC = mean(conversionToC,na.rm=TRUE),
ci.conversionToC = 1.96 * sd(conversionToC,na.rm=TRUE)/sqrt(n()),
mean.homophilyC = mean(homophilyC,na.rm=TRUE),
ci.homophilyC = 1.96 * sd(homophilyC,na.rm=TRUE)/sqrt(n()),
mean.homophilyD = mean(homophilyD,na.rm=TRUE),
ci.homophilyD = 1.96 * sd(homophilyD,na.rm=TRUE)/sqrt(n()),
mean.heterophily = mean(heterophily,na.rm=TRUE),
ci.heterophily = 1.96 * sd(heterophily,na.rm=TRUE)/sqrt(n()),
mean.transitivity = mean(transitivity,na.rm=TRUE),
ci.transitivity = 1.96 * sd(transitivity,na.rm=TRUE)/sqrt(n()),
mean.degree = mean(degree,na.rm=TRUE),
ci.degree = 1.96 * sd(degree,na.rm=TRUE)/sqrt(n()),
mean.degreeC = mean(degreeC,na.rm=TRUE),
ci.degreeC = 1.96 * sd(degreeC,na.rm=TRUE)/sqrt(n()),
mean.degreeD = mean(degreeD,na.rm=TRUE),
ci.degreeD = 1.96 * sd(degreeD,na.rm=TRUE)/sqrt(n()),
mean.meanConversionToD = mean(meanConversionToD,na.rm=TRUE),
ci.meanConversionToD = 1.96 * sd(meanConversionToD,na.rm=TRUE)/sqrt(n()),
mean.meanConversionToC = mean(meanConversionToC,na.rm=TRUE),
ci.meanConversionToC = 1.96 * sd(meanConversionToC,na.rm=TRUE)/sqrt(n()),
mean.degreeLost = mean(degreeLost,na.rm=TRUE),
ci.degreeLost = 1.96 * sd(degreeLost,na.rm=TRUE)/sqrt(n()),
mean.degreeLostC = mean(degreeLostC,na.rm=TRUE),
ci.degreeLostC = 1.96 * sd(degreeLostC,na.rm=TRUE)/sqrt(n()),
mean.degreeLostD = mean(degreeLostD,na.rm=TRUE),
ci.degreeLostD = 1.96 * sd(degreeLostD,na.rm=TRUE)/sqrt(n()),
mean.avg_wealth = mean(avg_wealth,na.rm=TRUE),
ci.avg_wealth = 1.96 * sd(avg_wealth,na.rm=TRUE)/sqrt(n()),
mean.gini = mean(gini,na.rm=TRUE),
ci.gini = 1.96 * sd(gini,na.rm=TRUE)/sqrt(n())
)
)
kable(sum.netIntLowDegree[c(1:9)]) %>% kableExtra::kable_styling(font_size = 10)
kable(sum.netIntLowDegree[c(1,10:17)]) %>% kableExtra::kable_styling(font_size = 10)
kable(sum.netIntLowDegree[c(1,18:25)]) %>% kableExtra::kable_styling(font_size = 10)
kable(sum.netIntLowDegree[c(1,26:33)]) %>% kableExtra::kable_styling(font_size = 10)
kable(sum.netIntLowDegree[c(1,34:ncol(sum.netIntLowDegree))]) %>% kableExtra::kable_styling(font_size = 10)
compare_means(percentIsolation ~ coopFrac, data=df.netIntLowDegree)
compare_means(avgCoop ~ coopFrac, data=df.netIntLowDegree)
compare_means(avgCoopFinal ~ coopFrac, data=df.netIntLowDegree)
compare_means(nCommunities ~ coopFrac, data=df.netIntLowDegree)
compare_means(communitySize ~ coopFrac, data=df.netIntLowDegree)
compare_means(assortativityInitial ~ coopFrac, data=df.netIntLowDegree)
compare_means(assortativityFinal ~ coopFrac, data=df.netIntLowDegree)
#compare_means(conversionRate ~ coopFrac, data=df.netIntLowDegree)
#compare_means(conversionToD ~ coopFrac, data=df.netIntLowDegree)
#compare_means(conversionToC ~ coopFrac, data=df.netIntLowDegree)
#compare_means(degreeC ~ coopFrac, data=df.netIntLowDegree)
#compare_means(degreeD ~ coopFrac, data=df.netIntLowDegree)
#compare_means(meanConversionToD ~ coopFrac, data=df.netIntLowDegree)
#compare_means(meanConversionToC ~ coopFrac, data=df.netIntLowDegree)
#compare_means(degreeLost ~ coopFrac, data=df.netIntLowDegree)
#compare_means(degreeLostC ~ coopFrac, data=df.netIntLowDegree)
#compare_means(degreeLostD ~ coopFrac, data=df.netIntLowDegree)
summary(lm(percentIsolation ~ assortativityInitial, data=df.netIntLowDegree))
#plot(df.netIntLowDegree$assortativityInitial, df.netIntLowDegree$percentIsolation)
#percentIsolation
g.percentIsolation = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="percentIsolation", add = "mean_se", color="coopFrac") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.098, method="t.test", color="black") +
labs(
title = paste("Isolation when defectors are assigned to 25% of nodes by degree, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Propoption of ever-isolated individuals") +
annotate("text", x=1, y=0.0990, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0022, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0024, xend = 3.7, yend = -0.0024), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0022, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,0.10)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.percentIsolation)
#percentIsolationC
#percentage of isolation among those who cooperated in both practice rounds
g.percentIsolationC = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="percentIsolationC", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.098, method="t.test", color="black") +
labs(
title = paste("Isolation among initial cooperators, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Propoption of ever-isolated individuals") +
annotate("text", x=1, y=0.0990, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0022, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0024, xend = 3.7, yend = -0.0024), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0022, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,0.10)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.percentIsolationC)
#percentIsolationD
#percentage of isolation among those who defected at least once in practice rounds
g.percentIsolationD = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="percentIsolationD", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.298, method="t.test", color="black") +
labs(
title = paste("Isolation among initial defectors, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Propoption of ever-isolated individuals") +
annotate("text", x=1, y=0.2990, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0062, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0064, xend = 3.7, yend = -0.0064), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0062, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,0.30)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.percentIsolationD)
#avgCoopFinal
g.avgCoopFinal = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="avgCoopFinal", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.98, method="t.test", color="black") +
labs(
title = paste("Cooperation in final round, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Propoption of cooperators in final round") +
annotate("text", x=1, y=0.990, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0212, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0214, xend = 3.7, yend = -0.0214), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0212, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,1.0)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.avgCoopFinal)
#avg_wealth
g.avg_wealth = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="avg_wealth", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 6800, method="t.test", color="black") +
labs(
title = paste("Wealth in final round, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Average wealth in final round") +
annotate("text", x=1, y=6900, label= "ref", color="black") +
annotate("text", x=2.4, y= -162, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -164, xend = 3.7, yend = -164), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -162, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,7000)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.avg_wealth)
#gini
g.gini = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="gini", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.48, method="t.test", color="black") +
labs(
title = paste("Gini coefficient in final round, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Gini coefficient in final round") +
annotate("text", x=1, y=0.490, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0112, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0114, xend = 3.7, yend = -0.0114), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0112, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,0.50)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.gini)
#degree
g.degree = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="degree", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 14.8, method="t.test", color="black") +
labs(
title = paste("Degree in final round, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Mean degree in final round") +
annotate("text", x=1, y=14.90, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.312, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.314, xend = 3.7, yend = -0.314), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.312, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,15)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.degree)
#transitivity
g.transitivity = ggbarplot(data=df.netIntLowDegree, x="coopFrac", y="transitivity", add = "mean_se") +
stat_compare_means(ref.group = "0", label = "p.signif", label.y = 0.98, method="t.test", color="black") +
labs(
title = paste("Transitivity in final round, ","V=",V,", Gini=",GINI,sep=""),
x = "Degree percentile of nodes assigned to defectors ",
y = "Transitivity in final round") +
annotate("text", x=1, y=0.99, label= "ref", color="black") +
annotate("text", x=2.4, y= -0.0212, label= "Lowest degree nodes assigned to defectors", size=2.5) +
geom_segment(aes(x = 3.3, y = -0.0214, xend = 3.7, yend = -0.0214), linewidth=0.2, arrow = arrow(length = unit(0.1, "cm"))) +
annotate("text", x=4.6, y= -0.0212, label= "Highest degree nodes assigned to defectors", size=2.5) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5, size=12),legend.position="none") +
coord_cartesian(ylim=c(0,1.00)) +
scale_x_discrete(labels=c('Control','0-25','25-50','50-75','75-100')) +
scale_color_manual(values = c('0' = "black",'0.25'="black",'0.5'="black",'0.75'="black",'1'="black")) +
geom_vline(xintercept = 1.5, linetype = "longdash")
print(g.transitivity)
#initial C-assortativity
plotList <- lapply(
unique(df.netIntLowDegree$coopFrac),
function(key) {
if(key==0){
ggplot(data = df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,], aes(x = homophilyC, y = percentIsolation)) +
geom_point() +
scale_x_continuous(paste("C-assortativity, ","Control",sep="")) +
scale_y_continuous("Proportion isolated") +
geom_smooth(method='lm', formula= y~x) +
stat_cor(method = "pearson")
}
else{
ggplot(data = df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,], aes(x = homophilyC, y = percentIsolation)) +
geom_point() +
scale_x_continuous(paste("C-assortativity, degree %ile = ",key,sep="")) +
scale_y_continuous("Proportion isolated") +
geom_smooth(method='lm', formula= y~x) +
stat_cor(method = "pearson")
}
}
)
plot= ggarrange(plotlist=plotList)
print(annotate_figure(plot, top = text_grob(paste("Proportion of ever-isolated individuals, ","V=",V,", Gini=", GINI, sep=""), color = "black", face = "bold", size = 10)))
lapply(unique(df.netIntLowDegree$coopFrac),
function(key) {
if(key==0){
reg = lm(percentIsolation ~ homophilyC + degreeD, data=df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,])
print(paste("Regression on proportion of ever-isolated individuals, ","Control"," ; ",sep=""))
print(summary(reg)[4]$coefficients)
}
else{
reg = lm(percentIsolation ~ homophilyC + degreeD, data=df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,])
print(paste("Regression on proportion of ever-isolated individuals, degree %ile = ",key," ; ",sep=""))
print(summary(reg)[4]$coefficients)
}
}
)
#initial D-assortativity
plotList <- lapply(
unique(df.netIntLowDegree$coopFrac),
function(key) {
if(key==0){
ggplot(data = df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,], aes(x = homophilyD, y = percentIsolation)) +
geom_point() +
scale_x_continuous(paste("D-assortativity, ","Control",sep="")) +
scale_y_continuous("Proportion isolated") +
geom_smooth(method='lm', formula= y~x) +
stat_cor(method = "pearson")
}
else{
ggplot(data = df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,], aes(x = homophilyD, y = percentIsolation)) +
geom_point() +
scale_x_continuous(paste("D-assortativity, degree %ile = ",key,sep="")) +
scale_y_continuous("Proportion isolated") +
geom_smooth(method='lm', formula= y~x) +
stat_cor(method = "pearson")
}
}
)
plot= ggarrange(plotlist=plotList)
print(annotate_figure(plot, top = text_grob(paste("Proportion of ever-isolated individuals, ","V=",V,", Gini=", GINI, sep=""), color = "black", face = "bold", size = 10)))
lapply(unique(df.netIntLowDegree$coopFrac),
function(key) {
if(key==0){
reg = lm(percentIsolation ~ homophilyD + degreeD, data=df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,])
print(paste("Regression on proportion of ever-isolated individuals, ","Control"," ; ",sep=""))
print(summary(reg)[4]$coefficients)
}
else{
reg = lm(percentIsolation ~ homophilyD + degreeD, data=df.netIntLowDegree[df.netIntLowDegree$coopFrac==key,])
print(paste("Regression on proportion of ever-isolated individuals, degree %ile = ",key," ; ",sep=""))
print(summary(reg)[4]$coefficients)
}
}
)
}
}
## Loading data last updated on 2023-01-20 20:37:15
## Call model1.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 20:39:47
## Call model2.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.








## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.19133333 0.016087796 11.893073 7.065608e-29
## homophilyC -0.10388682 0.028455945 -3.650795 2.891313e-04
## degreeD -0.02283162 0.002826937 -8.076452 5.081491e-15
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.247050020 0.015310152 16.1363537 2.082346e-47
## homophilyC -0.004262426 0.038560223 -0.1105395 9.120262e-01
## degreeD -0.046751075 0.003942555 -11.8580659 9.789694e-29
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16614076 0.014873075 11.1705722 5.301822e-26
## homophilyC -0.02554471 0.031131216 -0.8205496 4.122962e-01
## degreeD -0.02502266 0.003511613 -7.1256887 3.661903e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.11437144 0.014598400 7.834519 2.875865e-14
## homophilyC -0.04445873 0.026247738 -1.693812 9.092762e-02
## degreeD -0.01157412 0.002975299 -3.890071 1.138514e-04
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.083996447 0.014521882 5.7841295 1.290347e-08
## homophilyC 0.006115562 0.027337950 0.2237023 8.230809e-01
## degreeD -0.008789299 0.002621374 -3.3529362 8.606003e-04
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17204023 0.01452287 11.846157 1.093688e-28
## homophilyD 0.07783828 0.02982668 2.609687 9.335811e-03
## degreeD -0.03020826 0.00393670 -7.673500 8.917639e-14
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.25299165 0.014577793 17.354593 4.540826e-53
## homophilyD -0.03636842 0.026017492 -1.397845 1.627844e-01
## degreeD -0.04574771 0.003793236 -12.060339 1.499888e-29
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.163820317 0.014610566 11.2124552 3.635454e-26
## homophilyD -0.007288383 0.021590882 -0.3375676 7.358316e-01
## degreeD -0.025794643 0.003372681 -7.6481117 1.064235e-13
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.110777729 0.014513767 7.6325965 1.185413e-13
## homophilyD 0.003484392 0.020862098 0.1670202 8.674221e-01
## degreeD -0.013641866 0.002964847 -4.6012042 5.338614e-06
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.08252486 0.014623111 5.643454 2.806516e-08
## homophilyD 0.02330773 0.020081646 1.160649 2.463431e-01
## degreeD -0.00940555 0.002462151 -3.820055 1.503504e-04
## Loading data last updated on 2023-01-20 21:50:22
## Call model1.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 21:54:00
## Call model2.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.







## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).

## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17669715 0.015146942 11.665533 5.828466e-28
## homophilyC -0.04735031 0.024616601 -1.923511 5.498675e-02
## degreeD -0.02553552 0.002703326 -9.445967 1.373876e-19
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.19287645 0.012807647 15.059475 1.717193e-42
## homophilyC -0.07542674 0.031675651 -2.381222 1.763097e-02
## degreeD -0.02943494 0.003484143 -8.448260 3.283718e-16
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16630022 0.013989530 11.8874774 7.553940e-29
## homophilyC -0.01607794 0.027321486 -0.5884724 5.564831e-01
## degreeD -0.02839564 0.003360495 -8.4498396 3.259546e-16
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.159820214 0.012783926 12.501654 2.248535e-31
## homophilyC -0.003843293 0.026155520 -0.146940 8.832389e-01
## degreeD -0.024614922 0.002594433 -9.487591 9.803554e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.103080873 0.012142722 8.4891072 2.417137e-16
## homophilyC 0.007752618 0.022297513 0.3476898 7.282204e-01
## degreeD -0.013217939 0.002044637 -6.4646875 2.428182e-10
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15974575 0.013960121 11.4430058 4.489658e-27
## homophilyD -0.02264499 0.028500174 -0.7945563 4.272509e-01
## degreeD -0.02357261 0.003745161 -6.2941515 6.795408e-10
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.180736002 0.013277899 13.6117925 4.355222e-36
## homophilyD 0.005141338 0.022366104 0.2298719 8.182859e-01
## degreeD -0.032720430 0.003249688 -10.0687918 7.953276e-22
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17308697 0.013939750 12.416792 5.145056e-31
## homophilyD -0.06025763 0.024327797 -2.476904 1.358502e-02
## degreeD -0.02689448 0.003229333 -8.328183 8.066079e-16
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.159845786 0.01253294 12.7540529 1.983733e-32
## homophilyD -0.008526361 0.01889201 -0.4513211 6.519550e-01
## degreeD -0.024356099 0.00254631 -9.5652538 5.209106e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10546980 0.011952510 8.8240714 1.892829e-17
## homophilyD -0.01346666 0.017687396 -0.7613705 4.467977e-01
## degreeD -0.01252869 0.002026874 -6.1812870 1.328336e-09
## Loading data last updated on 2023-01-20 20:37:15
## Call model1.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 20:39:47
## Call model2.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.







## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).

## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.21365448 0.015913992 13.425575 2.771259e-35
## homophilyC -0.09583198 0.025863200 -3.705341 2.348116e-04
## degreeD -0.02764188 0.002840224 -9.732291 1.321495e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22275368 0.014475240 15.3885997 5.552732e-44
## homophilyC -0.01786972 0.035799913 -0.4991554 6.178908e-01
## degreeD -0.03745058 0.003937789 -9.5105619 8.134152e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17762545 0.015182788 11.6991323 4.333992e-28
## homophilyC -0.00874813 0.029651915 -0.2950275 7.680963e-01
## degreeD -0.02839432 0.003647134 -7.7853785 4.083268e-14
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.161492918 0.015541089 10.3913513 5.078219e-23
## homophilyC 0.007217347 0.031796592 0.2269849 8.205288e-01
## degreeD -0.023714163 0.003153986 -7.5187918 2.601199e-13
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10006808 0.013827026 7.2371372 1.749555e-12
## homophilyC -0.01119548 0.025390376 -0.4409341 6.594525e-01
## degreeD -0.01036311 0.002328246 -4.4510359 1.055879e-05
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.18775621 0.014819228 12.6697698 4.474627e-32
## homophilyD 0.01448964 0.030254076 0.4789317 6.321979e-01
## degreeD -0.02913753 0.003975639 -7.3290170 9.453139e-13
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22565204 0.014915055 15.1291458 8.323458e-43
## homophilyD -0.02182457 0.025123830 -0.8686801 3.854414e-01
## degreeD -0.03787526 0.003650372 -10.3757245 5.809568e-23
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17593473 0.015264883 11.5254556 2.140686e-27
## homophilyD -0.00727996 0.026640433 -0.2732673 7.847615e-01
## degreeD -0.02803452 0.003536319 -7.9276017 1.488301e-14
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16458382 0.015172718 10.847353 9.480376e-25
## homophilyD -0.04791077 0.022871175 -2.094810 3.669354e-02
## degreeD -0.02111739 0.003082632 -6.850441 2.183912e-11
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.10207378 0.013580906 7.515977 2.659668e-13
## homophilyD -0.03462241 0.020097107 -1.722756 8.555596e-02
## degreeD -0.00950690 0.002303013 -4.128028 4.292207e-05
## Loading data last updated on 2023-01-20 21:50:22
## Call model1.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 21:54:00
## Call model2.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.







## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).

## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17765878 0.014600487 12.168003 5.359615e-30
## homophilyC -0.08042878 0.023728511 -3.389542 7.557759e-04
## degreeD -0.02371702 0.002605798 -9.101634 2.155431e-18
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.19249136 0.013503172 14.255270 6.683245e-39
## homophilyC -0.05534687 0.033395809 -1.657300 9.808992e-02
## degreeD -0.03113784 0.003673351 -8.476685 2.653479e-16
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15316845 0.014242087 10.7546353 2.170448e-24
## homophilyC -0.01167104 0.027814729 -0.4195991 6.749600e-01
## degreeD -0.02532255 0.003421163 -7.4017373 5.798634e-13
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.126090599 0.01259090 10.01442119 1.257694e-21
## homophilyC 0.002327531 0.02576060 0.09035237 9.280436e-01
## degreeD -0.019079656 0.00255526 -7.46681514 3.713226e-13
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.097375419 0.012333274 7.8953419 1.866909e-14
## homophilyC -0.003766353 0.022647421 -0.1663039 8.679855e-01
## degreeD -0.011537729 0.002076723 -5.5557383 4.512405e-08
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15628625 0.013565479 11.5208797 2.203021e-27
## homophilyD 0.01476507 0.027694494 0.5331411 5.941742e-01
## degreeD -0.02520837 0.003639288 -6.9267292 1.338721e-11
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.18824569 0.013953343 13.4910815 1.447232e-35
## homophilyD -0.01483343 0.023503864 -0.6311059 5.282614e-01
## degreeD -0.03326307 0.003414999 -9.7402867 1.237028e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16045395 0.014194616 11.303859 1.610944e-26
## homophilyD -0.05940907 0.024772593 -2.398177 1.684539e-02
## degreeD -0.02368778 0.003288377 -7.203486 2.194171e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.12749846 0.012325701 10.344115 7.623823e-23
## homophilyD -0.02382214 0.018579616 -1.282165 2.003824e-01
## degreeD -0.01783849 0.002504205 -7.123414 3.717181e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.09815167 0.012140629 8.0845622 4.809562e-15
## homophilyD -0.01171060 0.017965776 -0.6518281 5.148140e-01
## degreeD -0.01125161 0.002058775 -5.4651954 7.333682e-08
## Loading data last updated on 2023-01-20 20:37:15
## Call model1.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 20:39:47
## Call model2.invisible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.







## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).

## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.20694517 0.015093837 13.710574 1.624386e-36
## homophilyC -0.10699183 0.024530297 -4.361620 1.570504e-05
## degreeD -0.02572197 0.002693848 -9.548414 5.976378e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22790089 0.014519949 15.6957083 2.207368e-45
## homophilyC -0.01760677 0.035910486 -0.4902961 6.241407e-01
## degreeD -0.03930588 0.003949951 -9.9509792 2.142548e-21
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17133615 0.016041206 10.6810015 4.142032e-24
## homophilyC -0.01041358 0.031328401 -0.3324007 7.397271e-01
## degreeD -0.02703278 0.003853338 -7.0154181 7.555327e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16278414 0.015456024 10.5320833 1.503191e-23
## homophilyC 0.01666880 0.031622552 0.5271173 5.983473e-01
## degreeD -0.02436491 0.003136722 -7.7676321 4.611696e-14
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.074568134 0.012977928 5.7457656 1.596960e-08
## homophilyC 0.017688206 0.023831190 0.7422292 4.582991e-01
## degreeD -0.008088385 0.002185272 -3.7013173 2.384649e-04
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.176335503 0.014131140 12.4785052 2.805899e-31
## homophilyD 0.004015549 0.028849315 0.1391905 8.893560e-01
## degreeD -0.026289294 0.003791042 -6.9345834 1.272631e-11
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22849779 0.014968649 15.265091 2.018866e-43
## homophilyD -0.01249001 0.025214107 -0.495358 6.205664e-01
## degreeD -0.03986266 0.003663489 -10.881065 7.034317e-25
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17527619 0.016051506 10.919610 5.052578e-25
## homophilyD -0.04083803 0.028013256 -1.457811 1.455255e-01
## degreeD -0.02579425 0.003718551 -6.936642 1.258569e-11
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16680750 0.015094348 11.050991 1.549920e-25
## homophilyD -0.04721236 0.022753042 -2.074991 3.850130e-02
## degreeD -0.02142707 0.003066709 -6.986991 9.067554e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.080535444 0.012737626 6.322641 5.739671e-10
## homophilyD -0.036642344 0.018849216 -1.943972 5.246395e-02
## degreeD -0.006309743 0.002160012 -2.921162 3.646220e-03
## Loading data last updated on 2023-01-20 21:50:22
## Call model1.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 21:54:00
## Call model2.visible(redo=TRUE) to update data.
## Loading data last updated on 2023-01-20 22:02:59
## Call model3(redo=TRUE) to update data.







## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).

## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.18564489 0.014338839 12.946996 3.050891e-33
## homophilyC -0.08622048 0.023303284 -3.699928 2.397386e-04
## degreeD -0.02456384 0.002559101 -9.598623 3.965593e-20
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.21290855 0.013134165 16.210284 9.485209e-48
## homophilyC -0.08093062 0.032483190 -2.491462 1.304690e-02
## degreeD -0.03274045 0.003572968 -9.163376 1.322497e-18
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15270634 0.013057417 11.6949881 4.503054e-28
## homophilyC 0.01420079 0.025501074 0.5568701 5.778673e-01
## degreeD -0.02739930 0.003136587 -8.7353853 3.745202e-17
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.13904463 0.013545458 10.2650373 1.501235e-22
## homophilyC -0.00863497 0.027713591 -0.3115789 7.554912e-01
## degreeD -0.02110283 0.002748983 -7.6765982 8.726989e-14
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.08744774 0.011621834 7.524436 2.502297e-13
## homophilyC -0.02822587 0.021341013 -1.322612 1.865729e-01
## degreeD -0.00932389 0.001956928 -4.764555 2.488204e-06
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 1 rows containing non-finite values (`stat_cor()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).


## [1] "Regression on proportion of ever-isolated individuals, Control ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15836650 0.013350651 11.8620807 9.430592e-29
## homophilyD -0.01549441 0.027255914 -0.5684789 5.699666e-01
## degreeD -0.02332302 0.003581655 -6.5118002 1.820205e-10
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.25 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.199482061 0.01362309 14.6429421 1.270167e-40
## homophilyD 0.007113247 0.02294756 0.3099784 7.567073e-01
## degreeD -0.036290184 0.00333417 -10.8843218 6.834201e-25
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.5 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.16017695 0.013048138 12.275847 1.964249e-30
## homophilyD -0.04038714 0.022771747 -1.773564 7.674889e-02
## degreeD -0.02530254 0.003022779 -8.370620 5.886617e-16
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 0.75 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.14030311 0.013219693 10.613190 7.418582e-24
## homophilyD -0.04361499 0.019927209 -2.188715 2.908213e-02
## degreeD -0.01934176 0.002685837 -7.201390 2.219415e-12
## [1] "Regression on proportion of ever-isolated individuals, degree %ile = 1 ; "
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.08193383 0.011449250 7.156262 3.000178e-12
## homophilyD 0.02045067 0.016942668 1.207051 2.279877e-01
## degreeD -0.01086753 0.001941532 -5.597401 3.605783e-08
plot.trends <-
data.frame(
trends.df %>%
group_by(round, V, GINI, fractionCoop) %>%
summarize_all(list(mean=~mean(., na.rm=TRUE),sd=~sd(., na.rm=TRUE)))
)
plot.trends$V = factor(plot.trends$V)
plot.trends$GINI = factor(plot.trends$GINI)
for(i in unique(plot.trends$fractionCoop)){
g.gini = ggplot(data=plot.trends[plot.trends$fractionCoop==i,], aes(x=round,y=gini_mean,group=interaction(GINI,V))) +
geom_line(aes(color=GINI,linetype=V)) +
geom_ribbon(aes(ymin = gini_mean - gini_sd, ymax = gini_mean + gini_sd, fill=GINI),alpha=0.3) +
xlab("Round")+
ylab("gini") +
theme_bw()
g.gmd = ggplot(data=plot.trends[plot.trends$fractionCoop==i,], aes(x=round,y=gmd_mean,group=interaction(GINI,V))) +
geom_line(aes(color=GINI,linetype=V)) +
geom_ribbon(aes(ymin = gmd_mean - gmd_sd, ymax = gmd_mean + gmd_sd, fill=GINI),alpha=0.3) +
xlab("Round")+
ylab("gmd") +
theme_bw()
g.avg_wealth = ggplot(data=plot.trends[plot.trends$fractionCoop==i,], aes(x=round,y=avg_wealth_mean,group=interaction(GINI,V))) +
geom_line(aes(color=GINI,linetype=V)) +
geom_ribbon(aes(ymin = avg_wealth_mean - avg_wealth_sd, ymax = avg_wealth_mean + avg_wealth_sd, fill=GINI),alpha=0.3) +
xlab("Round")+
ylab("avg_wealth") +
theme_bw()
g.avg_coop = ggplot(data=plot.trends[plot.trends$fractionCoop==i,], aes(x=round,y=avg_coop_mean,group=interaction(GINI,V))) +
geom_line(aes(color=GINI,linetype=V)) +
geom_ribbon(aes(ymin = avg_coop_mean - avg_coop_sd, ymax = avg_coop_mean + avg_coop_sd, fill=GINI),alpha=0.3) +
xlab("Round")+
ylab("avg_coop") +
theme_bw()
g.avg_degree = ggplot(data=plot.trends[plot.trends$fractionCoop==i,], aes(x=round,y=avg_degree_mean,group=interaction(GINI,V))) +
geom_line(aes(color=GINI,linetype=V)) +
geom_ribbon(aes(ymin = avg_degree_mean - avg_degree_sd, ymax = avg_degree_mean + avg_degree_sd, fill=GINI),alpha=0.3) +
xlab("Round")+
ylab("avg_degree") +
theme_bw()
plot <- ggarrange(g.gini,g.gmd,g.avg_wealth,g.avg_coop,g.avg_degree,common.legend = TRUE,legend="bottom")
print(annotate_figure(plot, top = text_grob(paste("Degree percentile of nodes assigned to defectors =",i), color = "black", face = "bold", size = 10)))
}
## Warning: Removed 6 rows containing missing values (`geom_line()`).
## Warning: Removed 6 rows containing missing values (`geom_line()`).

## Warning: Removed 6 rows containing missing values (`geom_line()`).

## Warning: Removed 6 rows containing missing values (`geom_line()`).

## Warning: Removed 6 rows containing missing values (`geom_line()`).


fig1 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = homophilyC, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("C-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig2 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = homophilyD, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("D-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig3 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = heterophily, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("Heterophily") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig4 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = homophilyC, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("C-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig5 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = homophilyD, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("D-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig6 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = heterophily, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("Heterophily") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
fig7 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = degreeD, color = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("Mean degree of defectors") +
scale_color_viridis(option = "magma") +
labs(color="Isolated \nindividuals (%)")
print(ggarrange(fig1,fig2,fig3,fig4,fig5,fig6,fig7,common.legend = TRUE,legend="right"))
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).

fig1 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("Isolated individuals (%)")
fig2 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = percentIsolation*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("Isolated individuals (%)")
fig3 = ggplot(data = df.netIntLowDegree,
aes(x = homophilyC, y = percentIsolation*100)) +
geom_point() +
scale_x_continuous("C-assortativity") +
scale_y_continuous("Isolated individuals (%)")
fig4 = ggplot(data = df.netIntLowDegree,
aes(x = homophilyD, y = percentIsolation*100)) +
geom_point() +
scale_x_continuous("D-assortativity") +
scale_y_continuous("Isolated individuals (%)")
print(ggarrange(fig1,fig2,fig3,fig4,common.legend = TRUE,legend="right"))
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).

reg.isolation = glm(percentIsolation*100 ~ degreeC + degreeD + homophilyC + homophilyD + heterophily, data=df.netIntLowDegree, family = gaussian(link = "identity"))
summary(reg.isolation)
##
## Call:
## glm(formula = percentIsolation * 100 ~ degreeC + degreeD + homophilyC +
## homophilyD + heterophily, family = gaussian(link = "identity"),
## data = df.netIntLowDegree)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -10.6961 -3.5172 -0.7522 2.4370 23.2534
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 18.1507 0.7225 25.122 < 2e-16 ***
## degreeC -0.5036 0.1919 -2.625 0.00872 **
## degreeD -2.0545 0.1565 -13.127 < 2e-16 ***
## homophilyC -2.5865 1.6276 -1.589 0.11214
## homophilyD -0.7001 1.1628 -0.602 0.54718
## heterophily -2.8796 3.1695 -0.909 0.36369
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 22.82672)
##
## Null deviance: 72007 on 2496 degrees of freedom
## Residual deviance: 56861 on 2491 degrees of freedom
## (3 observations deleted due to missingness)
## AIC: 14905
##
## Number of Fisher Scoring iterations: 2
#variance inflation factor
car::vif(reg.isolation)
## degreeC degreeD homophilyC homophilyD heterophily
## 3.896292 3.491527 2.096700 1.636447 3.449378
reg.isolation = glm(percentIsolation*100 ~ degreeD + homophilyD, data=df.netIntLowDegree, family = gaussian(link = "identity"))
summary(reg.isolation)
##
## Call:
## glm(formula = percentIsolation * 100 ~ degreeD + homophilyD,
## family = gaussian(link = "identity"), data = df.netIntLowDegree)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -10.6242 -3.5350 -0.8284 2.4292 24.4377
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 14.19407 0.45722 31.044 <2e-16 ***
## degreeD -2.03992 0.08711 -23.418 <2e-16 ***
## homophilyD -1.37839 0.94543 -1.458 0.145
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 23.25419)
##
## Null deviance: 72022 on 2497 degrees of freedom
## Residual deviance: 58019 on 2495 degrees of freedom
## (2 observations deleted due to missingness)
## AIC: 14954
##
## Number of Fisher Scoring iterations: 2
#variance inflation factor
car::vif(reg.isolation)
## degreeD homophilyD
## 1.062003 1.062003
#double machine learning
library(DoubleML)
library(mlr3)
library(mlr3learners)
set.seed(3141)
##degreeC
dml_data = DoubleMLData$new(df.netIntLowDegree[complete.cases(df.netIntLowDegree[c("percentIsolation","degreeC","degreeD","homophilyC","homophilyD","heterophily")]),],
y_col = "percentIsolation",
d_cols = "degreeC",
x_cols = c("degreeD","homophilyC","homophilyD","heterophily"))
print(dml_data)
## ================= DoubleMLData Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): degreeC
## Covariates: degreeD, homophilyC, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
# surpress messages from mlr3 package during fitting
lgr::get_logger("mlr3")$set_threshold("warn")
learner = lrn("regr.ranger", num.trees=500, mtry=floor(sqrt(4)), max.depth=5, min.node.size=2)
ml_l = learner$clone()
ml_m = learner$clone()
obj_dml_plr = DoubleMLPLR$new(dml_data, ml_l=ml_l, ml_m=ml_m)
obj_dml_plr$fit()
print(obj_dml_plr)
## ================= DoubleMLPLR Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): degreeC
## Covariates: degreeD, homophilyC, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
##
## ------------------ Score & algorithm ------------------
## Score function: partialling out
## DML algorithm: dml2
##
## ------------------ Machine learner ------------------
## ml_l: regr.ranger
## ml_m: regr.ranger
##
## ------------------ Resampling ------------------
## No. folds: 5
## No. repeated sample splits: 1
## Apply cross-fitting: TRUE
##
## ------------------ Fit summary ------------------
## Estimates and significance testing of the effect of target variables
## Estimate. Std. Error t value Pr(>|t|)
## degreeC -0.002263 0.001664 -1.36 0.174
##degreeD
dml_data = DoubleMLData$new(df.netIntLowDegree[complete.cases(df.netIntLowDegree[c("percentIsolation","degreeC","degreeD","homophilyC","homophilyD","heterophily")]),],
y_col = "percentIsolation",
d_cols = "degreeD",
x_cols = c("degreeC","homophilyC","homophilyD","heterophily"))
print(dml_data)
## ================= DoubleMLData Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): degreeD
## Covariates: degreeC, homophilyC, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
# surpress messages from mlr3 package during fitting
lgr::get_logger("mlr3")$set_threshold("warn")
learner = lrn("regr.ranger", num.trees=500, mtry=floor(sqrt(4)), max.depth=5, min.node.size=2)
ml_l = learner$clone()
ml_m = learner$clone()
obj_dml_plr = DoubleMLPLR$new(dml_data, ml_l=ml_l, ml_m=ml_m)
obj_dml_plr$fit()
print(obj_dml_plr)
## ================= DoubleMLPLR Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): degreeD
## Covariates: degreeC, homophilyC, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
##
## ------------------ Score & algorithm ------------------
## Score function: partialling out
## DML algorithm: dml2
##
## ------------------ Machine learner ------------------
## ml_l: regr.ranger
## ml_m: regr.ranger
##
## ------------------ Resampling ------------------
## No. folds: 5
## No. repeated sample splits: 1
## Apply cross-fitting: TRUE
##
## ------------------ Fit summary ------------------
## Estimates and significance testing of the effect of target variables
## Estimate. Std. Error t value Pr(>|t|)
## degreeD -0.019070 0.001476 -12.92 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##homophilyC
dml_data = DoubleMLData$new(df.netIntLowDegree[complete.cases(df.netIntLowDegree[c("percentIsolation","degreeC","degreeD","homophilyC","homophilyD","heterophily")]),],
y_col = "percentIsolation",
d_cols = "homophilyC",
x_cols = c("degreeC","degreeD","homophilyD","heterophily"))
print(dml_data)
## ================= DoubleMLData Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): homophilyC
## Covariates: degreeC, degreeD, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
# surpress messages from mlr3 package during fitting
lgr::get_logger("mlr3")$set_threshold("warn")
learner = lrn("regr.ranger", num.trees=500, mtry=floor(sqrt(4)), max.depth=5, min.node.size=2)
ml_l = learner$clone()
ml_m = learner$clone()
obj_dml_plr = DoubleMLPLR$new(dml_data, ml_l=ml_l, ml_m=ml_m)
obj_dml_plr$fit()
print(obj_dml_plr)
## ================= DoubleMLPLR Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): homophilyC
## Covariates: degreeC, degreeD, homophilyD, heterophily
## Instrument(s):
## No. Observations: 2497
##
## ------------------ Score & algorithm ------------------
## Score function: partialling out
## DML algorithm: dml2
##
## ------------------ Machine learner ------------------
## ml_l: regr.ranger
## ml_m: regr.ranger
##
## ------------------ Resampling ------------------
## No. folds: 5
## No. repeated sample splits: 1
## Apply cross-fitting: TRUE
##
## ------------------ Fit summary ------------------
## Estimates and significance testing of the effect of target variables
## Estimate. Std. Error t value Pr(>|t|)
## homophilyC -0.04375 0.01343 -3.256 0.00113 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##homophilyD
dml_data = DoubleMLData$new(df.netIntLowDegree[complete.cases(df.netIntLowDegree[c("percentIsolation","degreeC","degreeD","homophilyC","homophilyD","heterophily")]),],
y_col = "percentIsolation",
d_cols = "homophilyD",
x_cols = c("degreeC","degreeD","homophilyC","heterophily"))
print(dml_data)
## ================= DoubleMLData Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): homophilyD
## Covariates: degreeC, degreeD, homophilyC, heterophily
## Instrument(s):
## No. Observations: 2497
# surpress messages from mlr3 package during fitting
lgr::get_logger("mlr3")$set_threshold("warn")
learner = lrn("regr.ranger", num.trees=500, mtry=floor(sqrt(4)), max.depth=5, min.node.size=2)
ml_l = learner$clone()
ml_m = learner$clone()
obj_dml_plr = DoubleMLPLR$new(dml_data, ml_l=ml_l, ml_m=ml_m)
obj_dml_plr$fit()
print(obj_dml_plr)
## ================= DoubleMLPLR Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): homophilyD
## Covariates: degreeC, degreeD, homophilyC, heterophily
## Instrument(s):
## No. Observations: 2497
##
## ------------------ Score & algorithm ------------------
## Score function: partialling out
## DML algorithm: dml2
##
## ------------------ Machine learner ------------------
## ml_l: regr.ranger
## ml_m: regr.ranger
##
## ------------------ Resampling ------------------
## No. folds: 5
## No. repeated sample splits: 1
## Apply cross-fitting: TRUE
##
## ------------------ Fit summary ------------------
## Estimates and significance testing of the effect of target variables
## Estimate. Std. Error t value Pr(>|t|)
## homophilyD -0.03181 0.01014 -3.137 0.00171 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##heterophily
dml_data = DoubleMLData$new(df.netIntLowDegree[complete.cases(df.netIntLowDegree[c("percentIsolation","degreeC","degreeD","homophilyC","homophilyD","heterophily")]),],
y_col = "percentIsolation",
d_cols = "heterophily",
x_cols = c("degreeC","degreeD","homophilyC","homophilyD"))
print(dml_data)
## ================= DoubleMLData Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): heterophily
## Covariates: degreeC, degreeD, homophilyC, homophilyD
## Instrument(s):
## No. Observations: 2497
# surpress messages from mlr3 package during fitting
lgr::get_logger("mlr3")$set_threshold("warn")
learner = lrn("regr.ranger", num.trees=500, mtry=floor(sqrt(4)), max.depth=5, min.node.size=2)
ml_l = learner$clone()
ml_m = learner$clone()
obj_dml_plr = DoubleMLPLR$new(dml_data, ml_l=ml_l, ml_m=ml_m)
obj_dml_plr$fit()
print(obj_dml_plr)
## ================= DoubleMLPLR Object ==================
##
##
## ------------------ Data summary ------------------
## Outcome variable: percentIsolation
## Treatment variable(s): heterophily
## Covariates: degreeC, degreeD, homophilyC, homophilyD
## Instrument(s):
## No. Observations: 2497
##
## ------------------ Score & algorithm ------------------
## Score function: partialling out
## DML algorithm: dml2
##
## ------------------ Machine learner ------------------
## ml_l: regr.ranger
## ml_m: regr.ranger
##
## ------------------ Resampling ------------------
## No. folds: 5
## No. repeated sample splits: 1
## Apply cross-fitting: TRUE
##
## ------------------ Fit summary ------------------
## Estimates and significance testing of the effect of target variables
## Estimate. Std. Error t value Pr(>|t|)
## heterophily -0.07733 0.02653 -2.915 0.00356 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fig1 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = homophilyC, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("C-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig2 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = homophilyD, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("D-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig3 = ggplot(data = df.netIntLowDegree,
aes(x = degreeD, y = heterophily, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of defectors") +
scale_y_continuous("Heterophily") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig4 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = homophilyC, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("C-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig5 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = homophilyD, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("D-assortativity") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig6 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = heterophily, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("Heterophily") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
fig7 = ggplot(data = df.netIntLowDegree,
aes(x = degreeC, y = degreeD, color = avgCoopFinal*100)) +
geom_point() +
scale_x_continuous("Mean degree of cooperators") +
scale_y_continuous("Mean degree of defectors") +
scale_color_viridis(option = "magma") +
labs(color="Cooperation in \nfinal round (%)")
print(ggarrange(fig1,fig2,fig3,fig4,fig5,fig6,fig7,common.legend = TRUE,legend="right"))
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).
## Warning: Removed 1 rows containing missing values (`geom_point()`).
## Warning: Removed 2 rows containing missing values (`geom_point()`).
